home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 51 / Amiga Format CD51 (2000-03-10)(Future Publishing)(GB)[!][issue 2000-04].iso / -in_the_mag- / banging_the_metal / qdos / qdos4amiga3.lha / DOC2RTF_bas < prev    next >
Text File  |  1998-02-12  |  21KB  |  764 lines
  1. 10  TURBO_objfil "ram1_DOC2RTF_task"
  2. 11  TURBO_taskn "DOC2RTF"
  3. 12  TURBO_repfil "scr"
  4. 13  TURBO_windo 0
  5. 14  TURBO_diags 'omit'
  6. 15  TURBO_struct "S"
  7. 16  TURBO_model "<"
  8. 17  TURBO_objdat 10
  9. 18  TURBO_optim "R"
  10. 19 :
  11. 1000 REMark ------------------------------
  12. 1010 REMark    DOC2RTF_bas - Mark J Swift
  13. 1020 :
  14. 1052 REMark Thanks go to S N Goodwin for
  15. 1053 REMark obtaining vital information
  16. 1054 REMark about the DOC format, and to
  17. 1055 REMark Chas Dillon for providing it
  18. 1060 REMark ------------------------------
  19. 1070 :
  20. 1160 DIM InFile$(100),OutFile$(100),verstag$(4)
  21. 1170 DIM RTFtbs%(256),RTFtbs$(256),K$(1),extra$(4),RTFo$(4096),t$(256),ANSI%(256)
  22. 1180 cWdth=11880/98: REMark width of 10pt courier in 1/20 pts (approx)
  23. 1190 verstag$="1.03":REMark this version
  24. 1200 OPEN#3;"Con_456x144a28x12"
  25. 1210 OPEN#4;"Scr_104x12a362x20"
  26. 1220 OPEN#5;"Scr_436x52a38x99"
  27. 1222 RESTORE 6040
  28. 1224 FOR K=127 TO 255
  29. 1226  READ ANSI%(K)
  30. 1228 NEXT K
  31. 1230 REPeat outer_loop
  32. 1235  RETRY_HERE
  33. 1240  IF COMPILED
  34. 1241   WHEN ERRor 
  35. 1242    PRINT #3\\"Error: "
  36. 1243    REPORT #3,ERNUM
  37. 1244    INPUT #3;\" Press ENTER to re-start.";Rplc$
  38. 1245    RETRY
  39. 1246   END WHEN 
  40. 1247  END IF 
  41. 1249  WINDOW#3;456,144,28,12:PAPER#3;0:INK#3;7:CLS#3:BORDER#3;3,2:BORDER#3;2,0:BORDER#3;1,2:WINDOW#3;438,130,36,19:BORDER#5;1,4:INK#5;4:PAPER#5;0
  42. 1250  CSIZE#3;2,1:PRINT#3;"DOC2RTF v";verstag$:CSIZE#3;0,0
  43. 1260  PRINT#3;"DOC file translation utility by MARK J SWIFT";
  44. 1270  CLS#4:BORDER#4;1,7:INK#4;4:CLS#5
  45. 1280  WINDOW#3;438,40,36,59
  46. 1290  INK#5;4
  47. 1300  PRINT#5;" DOC2RTF is a file utility that translates QUILL/XCHANGE doc files into"
  48. 1310  PRINT#5;" rich text format (RTF)."
  49. 1320  PRINT#5;\" RTF files can easily be read into most PC and Apple Macintosh"
  50. 1330  PRINT#5;" word-processors and DTP applications."
  51. 1370  INPUT#3;\"      Input source DOC filename  >";InFile$
  52. 1380  IF InFile$="" THEN EXIT outer_loop
  53. 1390  INPUT#3;" Input destination RTF filename  >";OutFile$
  54. 1400  IF OutFile$="" THEN EXIT outer_loop
  55. 1410  CLS#5
  56. 1419  DOCbeginDocument InFile$
  57. 1420  RTFleading=240
  58. 1421  IF (DOChjust<>0) THEN DOCdoHeader
  59. 1422  IF (DOCfjust<>0) THEN DOCdoFooter
  60. 1423  DOCclearEnhance
  61. 1425  SET_POSITION#6,tblOffs+22+14+14
  62. 1427  RTFleading=240*(1+DOCLineGap)
  63. 1430  REPeat tblLoop
  64. 1440   IF DOCdone% THEN EXIT tblLoop
  65. 1450   DOCdoParagraph
  66. 1460   IF txtOffs>tblOffs THEN 
  67. 1470    BLOCK#4;100,10,0,0,4
  68. 1480   ELSE 
  69. 1490    BLOCK#4;INT((txtOffs/tblOffs)*100),10,0,0,4
  70. 1500   END IF 
  71. 1510  END REPeat tblLoop
  72. 1520  DOCendDocument
  73. 1540 END REPeat outer_loop
  74. 1550 CLOSE#3
  75. 1560 CLOSE#4
  76. 1570 CLOSE#5
  77. 1580 STOP
  78. 1581 :
  79. 1582 DEFine FuNction HEX4$(b%)
  80. 1583  RETurn "0123456789abcdef"(b%+1)
  81. 1584 END DEFine 
  82. 1585 DEFine FuNction HEX8$(c%)
  83. 1586  RETurn HEX4$(c% DIV 16)&HEX4$(c% && 15)
  84. 1587 END DEFine 
  85. 1590 :
  86. 1600 DEFine PROCedure DOCbeginDocument(InFile$)
  87. 1610  OPEN_IN#6,InFile$
  88. 1620  SET_POSITION#6,10
  89. 1630  tblOffs=STRINGL(INPUT$(#6,4))
  90. 1641  tblLen=STRING%(INPUT$(#6,2))
  91. 1645  PagOffs=tblOffs+tblLen
  92. 1647  PagLen=STRING%(INPUT$(#6,2))
  93. 1648  GenOffs=PagOffs+PagLen
  94. 1649  GenLen=STRING%(INPUT$(#6,2))
  95. 1650  RulOffs=GenOffs+20
  96. 1651  rulLen=GenLen-20
  97. 1652  GenLen=20
  98. 1659  OPEN_IN#7,InFile$
  99. 1660  DOCclearEnhance
  100. 1670  DOCrulID=0
  101. 1680  SET_POSITION#6,GenOffs
  102. 1681  DOCbotM=CODE(INKEY$(#6,-1))
  103. 1689  K=CODE(INKEY$(#6,-1))
  104. 1690  SELect ON K
  105. 1691  =1:DOCpwid=40
  106. 1692  =2:DOCpwid=64
  107. 1693  =REMAINDER :DOCpwid=80
  108. 1694  END SELect 
  109. 1695  RTFpwid=INT(cWdth*DOCpwid+.5)
  110. 1696  SET_POSITION#6,GenOffs+2
  111. 1697  DOCLineGap=CODE(INKEY$(#6,-1))
  112. 1698  DOCLinePP=CODE(INKEY$(#6,-1))
  113. 1699  DOCStartPag=CODE(INKEY$(#6,-1))
  114. 1700  SET_POSITION#6,GenOffs+6
  115. 1701  DOCtopM=CODE(INKEY$(#6,-1))
  116. 1702  SET_POSITION#6,GenOffs+14
  117. 1703  DOChjust=CODE(INKEY$(#6,-1))
  118. 1704  DOCfjust=CODE(INKEY$(#6,-1))
  119. 1705  DOChGap=CODE(INKEY$(#6,-1))
  120. 1706  DOCfGap=CODE(INKEY$(#6,-1))
  121. 1707  IF DOCLinePP>70 THEN DOCLinePP=70
  122. 1708  RTFextra=240*(70-DOCLinePP)/2
  123. 1709  RTFheadery=240*DOCtopM+RTFextra
  124. 1710  RTFfootery=240*DOCbotM+RTFextra
  125. 1711  RTFmargt=RTFheadery
  126. 1712  IF (DOChjust<>0) THEN RTFmargt=RTFmargt+240*(1+DOChGap)
  127. 1713  RTFmargb=RTFfootery
  128. 1714  IF (DOCfjust<>0) THEN RTFmargb=RTFmargb+240*(DOCfGap+1)
  129. 1717  RTFstartPag=DOCStartPag
  130. 1720  RTFbeginDocument OutFile$
  131. 1730 END DEFine 
  132. 1740 :
  133. 1750 DEFine PROCedure DOCendDocument
  134. 1760  CLOSE#6
  135. 1770  CLOSE#7
  136. 1780  RTFendDocument
  137. 1790 END DEFine 
  138. 1800 :
  139. 1810 DEFine FuNction DOCdone%
  140. 1811  RETurn POSITION(#7)>=tblOffs
  141. 1812 END DEFine 
  142. 1813 :
  143. 1814 DEFine PROCedure DOCdoFooter
  144. 1815  RTFbeginFooter
  145. 1816  SET_POSITION#6,tblOffs+22+14
  146. 1817  txtOffs=STRINGL(INPUT$(#6,4))
  147. 1818  SET_POSITION#6,GenOffs+15
  148. 1819  DOCdoHeaderFooter
  149. 1820  RTFendFooter
  150. 1821 END DEFine 
  151. 1822 :
  152. 1823 DEFine PROCedure DOCdoHeader
  153. 1824  RTFbeginHeader
  154. 1825  SET_POSITION#6,tblOffs+22
  155. 1826  txtOffs=STRINGL(INPUT$(#6,4))
  156. 1827  SET_POSITION#6,GenOffs+14
  157. 1828  DOCdoHeaderFooter
  158. 1829  RTFendHeader
  159. 1830 END DEFine 
  160. 1831 :
  161. 1832 DEFine PROCedure DOCdoHeaderFooter
  162. 1833  DOCclearEnhance
  163. 1834  DOCjFlg=CODE(INKEY$(#6,-1))
  164. 1835  SELect ON DOCjFlg
  165. 1836  =1:RTFleftAlign
  166. 1837  =2:RTFcentreAlign
  167. 1838  =3:RTFrightAlign
  168. 1839  END SELect 
  169. 1840  extra$=INKEY$(#6,-1)
  170. 1841  extra$=INPUT$(#6,2)
  171. 1842  Kk=CODE(INKEY$(#6,-1))
  172. 1843  IF Kk<>0 THEN DOCbold
  173. 1844  SET_POSITION#7,txtOffs
  174. 1845  REPeat txtLoop
  175. 1846   IF EOF(#7) THEN EXIT txtLoop
  176. 1847   K$=INKEY$(#7,-1)
  177. 1848   K=CODE(K$)
  178. 1849   IF K=0 THEN EXIT txtLoop
  179. 1850   RTFoutChar K$
  180. 1851  END REPeat txtLoop
  181. 1852  IF Kk<>0 THEN DOCbold
  182. 1853  REPeat loop
  183. 1854   K="nnn" INSTR RTFo$
  184. 1855   IF K=0 THEN K="aaa" INSTR RTFo$
  185. 1856   IF K=0 THEN EXIT loop
  186. 1857   IF K=(LEN(RTFo$)-2) THEN 
  187. 1858    RTFo$=RTFo$(1 TO K-1)&"\chpgn "
  188. 1859   ELSE 
  189. 1860    RTFo$=RTFo$(1 TO K-1)&"\chpgn "&RTFo$(K+3 TO LEN(RTFo$))
  190. 1861   END IF 
  191. 1862  END REPeat loop
  192. 1865 END DEFine 
  193. 1866 :
  194. 1867 DEFine PROCedure DOCdoParagraph
  195. 1868  DOCclearEnhance
  196. 1869  txtOffs=STRINGL(INPUT$(#6,4))
  197. 1870  IF txtOffs<>0 THEN 
  198. 1890   extra$=INPUT$(#6,2)
  199. 1900   extra$=INKEY$(#6,-1)
  200. 1910   t=CODE(INKEY$(#6,-1)):IF t>128 THEN t=128-t
  201. 1920   RTFleftIndent INT((t+1)*cWdth+.5)
  202. 1930   t=CODE(INKEY$(#6,-1)):IF t>128 THEN t=128-t
  203. 1940   RTFfirstIndent (INT((t+1)*cWdth+.5)-RTFli)
  204. 1950   t=CODE(INKEY$(#6,-1)):IF t>128 THEN t=128-t
  205. 1960   RTFrightIndent INT(RTFpwid-t*cWdth+.5)
  206. 1970   DOCjFlg=CODE(INKEY$(#6,-1))
  207. 1980   SELect ON DOCjFlg
  208. 1990   =0:RTFleftAlign
  209. 2000   =1:RTFcentreAlign
  210. 2010   =2:RTFjustify
  211. 2020   END SELect 
  212. 2021   K=CODE(INKEY$(#6,-1))
  213. 2022   IF K<>DOCrulID THEN 
  214. 2023    DOCrulID=K
  215. 2024    SET_POSITION#7,RulOffs
  216. 2025    REPeat loop
  217. 2026     K=CODE(INKEY$(#7,-1))
  218. 2027     L=CODE(INKEY$(#7,-1))-2
  219. 2028     IF K=DOCrulID THEN EXIT loop
  220. 2029     IF L>0 THEN K$=INPUT$(#7,L)
  221. 2030    END REPeat loop
  222. 2031    RTFnTbs%=0
  223. 2032    FOR i=1 TO L/2
  224. 2033     K=CODE(INKEY$(#7,-1))
  225. 2035     Kk=CODE(INKEY$(#7,-1))
  226. 2036     SELect ON Kk
  227. 2037     =0:RTFtab INT((K+1)*cWdth+.5),"L"
  228. 2038     =1:RTFtab INT((K+1)*cWdth+.5),"C"
  229. 2039     =2:RTFtab INT((K+1)*cWdth+.5),"R"
  230. 2040     =3:RTFtab INT((K+1)*cWdth+.5),"D"
  231. 2041     END SELect 
  232. 2044    END FOR i
  233. 2045    RTFleftIndent RTFli
  234. 2047   END IF 
  235. 2049   extra$=INPUT$(#6,2)
  236. 2050   RTFbeginParagraph
  237. 2055   SET_POSITION#7,txtOffs
  238. 2060   REPeat txtLoop
  239. 2070    IF EOF(#7) THEN EXIT txtLoop
  240. 2080    K$=INKEY$(#7,-1)
  241. 2090    K=CODE(K$)
  242. 2100    IF K=0 THEN EXIT txtLoop
  243. 2110    SELect ON K
  244. 2115    =9:RTFtabout
  245. 2120    =15:DOCbold
  246. 2130    =18:DOCsuperscript
  247. 2140    =17:DOCsubscript
  248. 2150    =16:DOCunderline
  249. 2160    =30:RTFoutChar "-"
  250. 2165    =12:DOCpagFlg%=1
  251. 2170    =REMAINDER : RTFoutChar K$
  252. 2180    END SELect 
  253. 2190   END REPeat txtLoop
  254. 2200   RTFendParagraph
  255. 2210  END IF 
  256. 2220 END DEFine 
  257. 2221 :
  258. 2222 DEFine PROCedure DOCclearEnhance
  259. 2223  DOCbldFlg%=0
  260. 2224  DOCitaFlg%=0
  261. 2225  DOCundFlg%=0
  262. 2226  DOCcndFlg%=0
  263. 2227  DOCsupFlg%=0
  264. 2228  DOCsubFlg%=0
  265. 2229 END DEFine 
  266. 2230 :
  267. 2240 DEFine PROCedure DOCbold
  268. 2250  DOCbldFlg%=1-DOCbldFlg%
  269. 2260  IF DOCbldFlg% THEN 
  270. 2270   RTFboldON
  271. 2280  ELSE 
  272. 2290   RTFboldOFF
  273. 2300  END IF 
  274. 2310 END DEFine 
  275. 2320 :
  276. 2330 DEFine PROCedure DOCsuperscript
  277. 2340  DOCsupFlg%=1-DOCsupFlg%
  278. 2350  IF DOCsupFlg% THEN 
  279. 2360   RTFsuperscriptON
  280. 2370  ELSE 
  281. 2380   RTFsuperscriptOFF
  282. 2390  END IF 
  283. 2400 END DEFine 
  284. 2410 :
  285. 2420 DEFine PROCedure DOCsubscript
  286. 2430  DOCsubFlg%=1-DOCsubFlg%
  287. 2440  IF DOCsubFlg% THEN 
  288. 2450   RTFsubscriptON
  289. 2460  ELSE 
  290. 2470   RTFsubscriptOFF
  291. 2480  END IF 
  292. 2490 END DEFine 
  293. 2500 :
  294. 2510 DEFine PROCedure DOCunderline
  295. 2520  DOCundFlg%=1-DOCundFlg%
  296. 2530  IF DOCundFlg% THEN 
  297. 2540   RTFunderlineON
  298. 2550  ELSE 
  299. 2560   RTFunderlineOFF
  300. 2570  END IF 
  301. 2580 END DEFine 
  302. 2590 :
  303. 2600 DEFine PROCedure RTFbeginDocument(OutFile$)
  304. 2610 :
  305. 2620  RTFclearEnhance
  306. 2690  RTFclearStyle
  307. 2790 :
  308. 2800  rtfparFlg%=0
  309. 2830 :
  310. 2835  DELETE OutFile$
  311. 2840  OPEN_NEW#9,OutFile$
  312. 2850  PRINT#9,"{\rtf0 \ansi"
  313. 2860  PRINT#9,""
  314. 2870  PRINT#9,"{\fonttbl"
  315. 2880  PRINT#9,"{\f22 \fmodern Courier;}"
  316. 2890  PRINT#9,"}"
  317. 2900  PRINT#9,""
  318. 2910  PRINT#9,"{\stylesheet"
  319. 2920  PRINT#9,"{\s243 \qc \f22 \fs20 \sbasedon0 \snext243 footer;}"
  320. 2930  PRINT#9,"{\s244 \qc \f22 \fs20 \sbasedon0 \snext244 header;}"
  321. 2940  PRINT#9,"{\f22 \fs20 \sbasedon222 \snext0 Normal;}"
  322. 2950  PRINT#9,"}"
  323. 2960  PRINT#9,""
  324. 2961  RTFmargl=1080
  325. 2962  RTFmargr=11880-RTFpwid-RTFmargl
  326. 2970  PRINT#9,"\paperw11880 \paperh16800 \deftab";INT(cWdth*5)
  327. 2975  PRINT#9,"\margl";RTFmargl;" \margr";RTFmargr;" \margt";-RTFmargt;" \margb";-RTFmargb
  328. 2980  PRINT#9,"\widowctrl \ftnbj \pgnstart";RTFstartPag;" \fracwidth "
  329. 2985  PRINT#9,"\sectd \linemod0 \linex0 \headery";RTFheadery;" \footery";RTFfootery;" \cols1 \endnhere"
  330. 2990  PRINT#9,"\plain \f22 \fs20 "
  331. 3000  PRINT#9,""
  332. 3010  RTFo$=""
  333. 3020 END DEFine 
  334. 3030 :
  335. 3040 DEFine PROCedure RTFendDocument
  336. 3050 :
  337. 3060  IF rtfparFlg% THEN 
  338. 3070    RTFendParagraph
  339. 3080  END IF 
  340. 3090 :
  341. 3100  PRINT#9,"}"
  342. 3110  CLOSE#9
  343. 3120 END DEFine 
  344. 3121 :
  345. 3122 DEFine PROCedure RTFbeginHeader
  346. 3123  PRINT#9;"{\header ":RTFbeginParagraph:RTFo$=RTFo$&"\s244 \f22 \fs20 "
  347. 3124 END DEFine 
  348. 3125 :
  349. 3126 DEFine PROCedure RTFendHeader
  350. 3128  RTFendParagraph:PRINT#9;"}":RTFclearStyle
  351. 3129 END DEFine 
  352. 3130 :
  353. 3132 DEFine PROCedure RTFbeginFooter
  354. 3133  PRINT#9;"{\footer ":RTFbeginParagraph:RTFo$=RTFo$&"\s243 \f22 \fs20 "
  355. 3134 END DEFine 
  356. 3135 :
  357. 3136 DEFine PROCedure RTFendFooter
  358. 3137  RTFendParagraph :PRINT#9;"}":RTFclearStyle
  359. 3138 END DEFine 
  360. 3139 :
  361. 3140 DEFine PROCedure RTFbeginParagraph
  362. 3150  IF rtfparFlg% THEN 
  363. 3160   RTFendParagraph
  364. 3200  END IF 
  365. 3220  rtfparFlg%=1
  366. 3225  RTFclearEnhance
  367. 3227  DOCpagFlg%=0
  368. 3230 END DEFine 
  369. 3240 :
  370. 3250 DEFine PROCedure RTFendParagraph
  371. 3260  IF rtfparFlg% THEN 
  372. 3270    RTFendEnhance
  373. 3280    RTFo$=RTFo$&"\par "
  374. 3285    RTFflushStyle
  375. 3290    PRINT#9,RTFo$
  376. 3295    RTFclearEnhance
  377. 3300    RTFo$=""
  378. 3310    rtfparFlg%=0
  379. 3315    IF DOCpagFlg%<>0 THEN 
  380. 3316     RTFpagebreak
  381. 3317     DOCpagFlg%=0
  382. 3318    END IF 
  383. 3320  END IF 
  384. 3330 END DEFine 
  385. 3331 :
  386. 3332 DEFine PROCedure RTFclearStyle
  387. 3333  RTFdefli=0
  388. 3334  RTFdeffi=0
  389. 3335  RTFdefri=0
  390. 3336  RTFli=RTFdefli
  391. 3337  RTFfi=RTFdeffi
  392. 3338  RTFri=RTFdefri
  393. 3339 :
  394. 3340  RTFalignFlg%=0
  395. 3341 :
  396. 3342  RTFnTbs%=0
  397. 3344 :
  398. 3345  RTFstyleFlg%=0
  399. 3348 END DEFine 
  400. 3349 :
  401. 3350 DEFine PROCedure RTFleftAlign
  402. 3360  IF RTFalignFlg%<>0 THEN 
  403. 3370   RTFalignFlg%=0
  404. 3380   RTFstyleFlg%=1
  405. 3390  END IF 
  406. 3400 END DEFine 
  407. 3410 :
  408. 3420 DEFine PROCedure RTFrightAlign
  409. 3430  IF RTFalignFlg%<>1 THEN 
  410. 3440   RTFalignFlg%=1
  411. 3450   RTFstyleFlg%=1
  412. 3460  END IF 
  413. 3470 END DEFine 
  414. 3480 :
  415. 3490 DEFine PROCedure RTFcentreAlign
  416. 3500  IF RTFalignFlg%<>2 THEN 
  417. 3510   RTFalignFlg%=2
  418. 3520   RTFstyleFlg%=1
  419. 3530  END IF 
  420. 3540 END DEFine 
  421. 3550 :
  422. 3560 DEFine PROCedure RTFjustify
  423. 3570  IF RTFalignFlg%<>3 THEN 
  424. 3580   RTFalignFlg%=3
  425. 3590   RTFstyleFlg%=1
  426. 3600  END IF 
  427. 3610 END DEFine 
  428. 3620 :
  429. 3630 DEFine PROCedure RTFleftIndent(N)
  430. 3640  REMark n - units of pts/20 as measured from the left margin
  431. 3650  IF N<>RTFli THEN 
  432. 3660    RTFli=N
  433. 3670    RTFstyleFlg%=1
  434. 3680  END IF 
  435. 3682  IF RTFstyleFlg%<>0 THEN 
  436. 3685   RTFclearSoftTabs
  437. 3690   RTFtab N,"S"
  438. 3695  END IF 
  439. 3700 END DEFine 
  440. 3710 :
  441. 3720 DEFine PROCedure RTFfirstIndent(N)
  442. 3730  REMark n - units of pts/20 as measured from the left indent
  443. 3740  IF N<>RTFfi THEN 
  444. 3750    RTFfi=N
  445. 3760    RTFstyleFlg%=1
  446. 3770  END IF 
  447. 3780 END DEFine 
  448. 3790 :
  449. 3800 DEFine PROCedure RTFrightIndent(N)
  450. 3810  REMark n - units of pts/20 as measured from the right margin
  451. 3820  IF N<>RTFri THEN 
  452. 3830    RTFri=N
  453. 3840    RTFstyleFlg%=1
  454. 3850  END IF 
  455. 3860 END DEFine 
  456. 3861 :
  457. 3862 DEFine PROCedure RTFclearSoftTabs
  458. 3863  i=1
  459. 3864  REPeat loop
  460. 3865   IF i>RTFnTbs% THEN EXIT loop
  461. 3866   IF RTFtbs$(i)=="S" THEN 
  462. 3867    FOR j=i TO RTFnTbs%-1
  463. 3868     RTFtbs%(j)=RTFtbs%(j+1)
  464. 3869     RTFtbs$(j)=RTFtbs$(j+1)
  465. 3870    END FOR j
  466. 3871    RTFnTbs%=RTFnTbs%-1
  467. 3872    RTFstyleFlg%=1
  468. 3873   END IF 
  469. 3874   i=i+1
  470. 3875   END REPeat loop
  471. 3878  END DEFine 
  472. 3879 :
  473. 3880 DEFine PROCedure RTFtab(N,t$)
  474. 3890  LOCal i,j,loop
  475. 3900  REMark n  - units of pts/20 as measured from the left margin
  476. 3910  REMark t$ - L=left tab, C=centre tab, R=right tab, D=decimal tab, X=remove tab
  477. 3920 :
  478. 3930  i=1
  479. 3940  REPeat loop
  480. 3950    IF ((i>RTFnTbs%) OR (RTFtbs%(i)>=N)) THEN EXIT loop
  481. 3960    i=i+1
  482. 3970  END REPeat loop
  483. 3980 :
  484. 3981  IF t$=="X" THEN 
  485. 3982   IF i<=RTFnTbs% THEN 
  486. 3983    REMark remove old tab
  487. 3984    FOR j=i TO RTFnTbs%-1
  488. 3985     RTFtbs%(j)=RTFtbs%(j+1)
  489. 3986     RTFtbs$(j)=RTFtbs$(j+1)
  490. 3987    END FOR j
  491. 3988    RTFnTbs%=RTFnTbs%-1
  492. 3989    RTFstyleFlg%=1
  493. 3990   END IF 
  494. 3991  ELSE 
  495. 3992   IF i>RTFnTbs% THEN 
  496. 3995    REMark add new tab to end of Q
  497. 4000    RTFnTbs%=RTFnTbs%+1
  498. 4010    RTFtbs%(RTFnTbs%)=N
  499. 4020    RTFtbs$(RTFnTbs%)=t$
  500. 4030    RTFstyleFlg%=1
  501. 4040   ELSE 
  502. 4050    IF N=RTFtbs%(i) THEN 
  503. 4055     REMark replace old tab with new
  504. 4059     IF NOT(t$=="S") THEN 
  505. 4060      IF RTFtbs$(i)<>t$ THEN 
  506. 4070       RTFtbs$(i)=t$
  507. 4080       RTFstyleFlg%=1
  508. 4090      END IF 
  509. 4095     END IF 
  510. 4100    ELSE 
  511. 4105     REMark insert new tab
  512. 4110     RTFnTbs%=RTFnTbs%+1
  513. 4120     FOR j=RTFnTbs%-1 TO i STEP -1
  514. 4130      RTFtbs%(j+1)=RTFtbs%(j)
  515. 4140      RTFtbs$(j+1)=RTFtbs$(j)
  516. 4150     NEXT j
  517. 4160     RTFtbs%(i)=N
  518. 4170     RTFtbs$(i)=t$
  519. 4180     RTFstyleFlg%=1
  520. 4190    END IF 
  521. 4195   END IF 
  522. 4200  END IF 
  523. 4210 :
  524. 4220 END DEFine 
  525. 4230 :
  526. 4240 DEFine PROCedure RTFflushStyle
  527. 4250  LOCal i,t
  528. 4260 :
  529. 4270  IF RTFstyleFlg% THEN 
  530. 4280    t=RTFalignFlg%
  531. 4290    SELect ON t
  532. 4300    =0:t$="\pard "
  533. 4310    =1:t$="\pard \qr "
  534. 4320    =2:t$="\pard \qc "
  535. 4330    =3:t$="\pard \qj "
  536. 4340    END SELect 
  537. 4350 :
  538. 4355    t$=t$&"\sl"&RTFleading&" "
  539. 4357 :
  540. 4360    IF RTFli<>RTFdefli THEN 
  541. 4370     t$=t$&"\li"&RTFli&" "
  542. 4380    END IF 
  543. 4390 :
  544. 4400    IF RTFfi<>RTFdeffi THEN 
  545. 4410     t$=t$&"\fi"&RTFfi&" "
  546. 4420    END IF 
  547. 4430 :
  548. 4440    IF RTFri<>RTFdefri THEN 
  549. 4450     t$=t$&"\ri"&RTFri&" "
  550. 4460    END IF 
  551. 4470 :
  552. 4480    IF RTFnTbs%<>0 THEN 
  553. 4490      FOR i=1 TO RTFnTbs%
  554. 4500        t=CODE(RTFtbs$(i))
  555. 4510        SELect ON t
  556. 4520        =CODE("L"),CODE("S")
  557. 4530          REMark left or soft tab
  558. 4540          t$=t$&"\tx"&RTFtbs%(i)&" "
  559. 4550        =CODE("C")
  560. 4560          REMark centre tab
  561. 4570          t$=t$&"\tqc\tx"&RTFtbs%(i)&"  "
  562. 4580        =CODE("R")
  563. 4590          REMark right tab
  564. 4600          t$=t$&"\tqr\tx"&RTFtbs%(i)&" "
  565. 4610        =CODE("D")
  566. 4620          REMark decimal tab
  567. 4630          t$=t$&"\tqdec\tx"&RTFtbs%(i)&" "
  568. 4640        END SELect 
  569. 4650      NEXT i
  570. 4660    END IF 
  571. 4670 :
  572. 4680    RTFo$=t$&RTFo$
  573. 4690 :
  574. 4700    RTFstyleFlg%=0
  575. 4710  END IF 
  576. 4720 END DEFine 
  577. 4730 :
  578. 4740 DEFine PROCedure RTFboldON
  579. 4750  IF RTFbldFlg%=0 THEN 
  580. 4760   RTFendEnhance
  581. 4770   RTFbldFlg%=1
  582. 4775   RTFenhFlg%=1
  583. 4780  END IF 
  584. 4790 END DEFine 
  585. 4800 :
  586. 4810 DEFine PROCedure RTFboldOFF
  587. 4820  IF RTFbldFlg%<>0 THEN 
  588. 4830   RTFendEnhance
  589. 4840   RTFbldFlg%=0
  590. 4845   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  591. 4850  END IF 
  592. 4860 END DEFine 
  593. 4870 :
  594. 4880 DEFine PROCedure RTFitalicON
  595. 4890  IF RTFitaFlg%=0 THEN 
  596. 4900   RTFendEnhance
  597. 4910   RTFitaFlg%=1
  598. 4915   RTFenhFlg%=1
  599. 4920  END IF 
  600. 4930 END DEFine 
  601. 4940 :
  602. 4950 DEFine PROCedure RTFitalicOFF
  603. 4960  IF RTFitaFlg%<>0 THEN 
  604. 4970   RTFendEnhance
  605. 4980   RTFitaFlg%=0
  606. 4985   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  607. 4990  END IF 
  608. 5000 END DEFine 
  609. 5010 :
  610. 5020 DEFine PROCedure RTFunderlineON
  611. 5030  IF RTFundFlg%=0 THEN 
  612. 5040   RTFendEnhance
  613. 5050   RTFundFlg%=1
  614. 5055   RTFenhFlg%=1
  615. 5060  END IF 
  616. 5070 END DEFine 
  617. 5080 :
  618. 5090 DEFine PROCedure RTFunderlineOFF
  619. 5100  IF RTFundFlg%<>0 THEN 
  620. 5110   RTFendEnhance
  621. 5120   RTFundFlg%=0
  622. 5125   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  623. 5130  END IF 
  624. 5140 END DEFine 
  625. 5150 :
  626. 5160 DEFine PROCedure RTFcondensedON
  627. 5170  IF RTFcndFlg%=0 THEN 
  628. 5180   RTFendEnhance
  629. 5190   RTFcndFlg%=1
  630. 5195   RTFenhFlg%=1
  631. 5200  END IF 
  632. 5210 END DEFine 
  633. 5220 :
  634. 5230 DEFine PROCedure RTFcondensedOFF
  635. 5240  IF RTFcndFlg%<>0 THEN 
  636. 5250   RTFendEnhance
  637. 5260   RTFcndFlg%=0
  638. 5265   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  639. 5270  END IF 
  640. 5280 END DEFine 
  641. 5290 :
  642. 5300 DEFine PROCedure RTFsuperscriptON
  643. 5310  IF RTFsupFlg%=0 THEN 
  644. 5320   RTFendEnhance
  645. 5330   RTFsupFlg%=1
  646. 5335   RTFenhFlg%=1
  647. 5340  END IF 
  648. 5350 END DEFine 
  649. 5360 :
  650. 5370 DEFine PROCedure RTFsuperscriptOFF
  651. 5380  IF RTFsupFlg%<>0 THEN 
  652. 5390   RTFendEnhance
  653. 5400   RTFsupFlg%=0
  654. 5405   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  655. 5410  END IF 
  656. 5420 END DEFine 
  657. 5430 :
  658. 5440 DEFine PROCedure RTFsubscriptON
  659. 5450  IF RTFsubFlg%=0 THEN 
  660. 5460   RTFendEnhance
  661. 5470   RTFsubFlg%=1
  662. 5475   RTFenhFlg%=1
  663. 5480  END IF 
  664. 5490 END DEFine 
  665. 5500 :
  666. 5510 DEFine PROCedure RTFsubscriptOFF
  667. 5520  IF RTFsubFlg%<>0 THEN 
  668. 5530   RTFendEnhance
  669. 5540   RTFsubFlg%=0
  670. 5545   RTFenhFlg%=RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%
  671. 5550  END IF 
  672. 5560 END DEFine 
  673. 5570 :
  674. 5580 DEFine PROCedure RTFendEnhance
  675. 5590  IF RTFenhFlg%=0 THEN 
  676. 5595   IF (RTFbldFlg%||RTFitaFlg%||RTFundFlg%||RTFcndFlg%||RTFsupFlg%||RTFsubFlg%) THEN 
  677. 5600    RTFo$=RTFo$&"}"
  678. 5605   END IF 
  679. 5606  END IF 
  680. 5607 END DEFine 
  681. 5608 :
  682. 5609 DEFine PROCedure RTFclearEnhance
  683. 5610  RTFbldFlg%=0
  684. 5620  RTFitaFlg%=0
  685. 5630  RTFundFlg%=0
  686. 5640  RTFcndFlg%=0
  687. 5650  RTFsupFlg%=0
  688. 5660  RTFsubFlg%=0
  689. 5670  RTFenhFlg%=0
  690. 5690 END DEFine 
  691. 5700 :
  692. 5710 DEFine PROCedure RTFflushEnhance
  693. 5720  IF RTFenhFlg% THEN 
  694. 5730   RTFo$=RTFo$&"{"
  695. 5740   IF RTFbldFlg% THEN 
  696. 5750    RTFo$=RTFo$&"\b "
  697. 5760   END IF 
  698. 5770   IF RTFitaFlg% THEN 
  699. 5780    RTFo$=RTFo$&"\i "
  700. 5790   END IF 
  701. 5800   IF RTFundFlg% THEN 
  702. 5810    RTFo$=RTFo$&"\ul "
  703. 5820   END IF 
  704. 5830   IF RTFcndFlg% THEN 
  705. 5840    RTFo$=RTFo$&"\expnd58 "
  706. 5850   END IF 
  707. 5860   IF RTFsupFlg% THEN 
  708. 5870    RTFo$=RTFo$&"\up6 "
  709. 5880   END IF 
  710. 5890   IF RTFsubFlg% THEN 
  711. 5900    RTFo$=RTFo$&"\dn4 "
  712. 5910   END IF 
  713. 5920  END IF 
  714. 5930  RTFenhFlg%=0
  715. 5940 END DEFine 
  716. 5950 :
  717. 5951 DEFine PROCedure RTFtabout
  718. 5952  IF RTFenhFlg% THEN RTFflushEnhance
  719. 5953  RTFo$=RTFo$&"\tab "
  720. 5954 END DEFine 
  721. 5955 :
  722. 5956 DEFine PROCedure RTFpagebreak
  723. 5957  PRINT#9;"\page "
  724. 5958 END DEFine 
  725. 5959 :
  726. 5960 DEFine PROCedure RTFoutChar(t$)
  727. 5965  LOCal K
  728. 5970  IF RTFenhFlg% THEN RTFflushEnhance
  729. 5992  K=CODE(t$)
  730. 5993  SELect ON K
  731. 5995  =CODE("{"),CODE("}"),CODE("\"):RTFo$=RTFo$&"\"&t$
  732. 5996  =32 TO 126:RTFo$=RTFo$&t$
  733. 5997  =127 TO 255
  734. 5998   c%=ANSI%(K)
  735. 5999   IF c%<128 THEN 
  736. 6000    RTFo$=RTFo$&CHR$(c%)
  737. 6001   ELSE 
  738. 6002    RTFo$=RTFo$&"\'"&HEX8$(c%)
  739. 6003   END IF 
  740. 6004  =REMAINDER :PRINT#5;"<";K;"> ";
  741. 6005  END SELect 
  742. 6010 END DEFine 
  743. 6020 :
  744. 6030 REMark QL ASCII TO ANSI CODE CONVERSION TABLE, ENTERED BY SIMON N GOODWIN.
  745. 6040 DATA 169, 228, 227                                    : REMark 127 .. 129
  746. 6050 DATA 229, 233, 246, 245, 248, 252, 231, 241, 230,  69 : REMark 130 .. 139
  747. 6060 DATA 225, 224, 226, 235, 232, 234, 239, 237, 236, 238 : REMark 140 .. 149
  748. 6070 DATA 243, 242, 244, 250, 249, 251, 223, 162, 165,  96 : REMark 150 .. 159
  749. 6080 DATA 196, 195, 197, 201, 214, 213, 216, 220, 199, 209 : REMark 160 .. 169
  750. 6090 DATA 198,  63,  63, 240,  63,  63, 181,  63,  63, 161 : REMark 170 .. 179
  751. 6100 DATA 191,  63, 167, 164, 171, 187, 176, 247,  63,  63 : REMark 180 .. 189
  752. 6110 DATA  63,  63,  63,  63,  63,  63,  63,  63,  63,  63 : REMark 190 .. 199
  753. 6120 DATA  63,  63,  63,  63,  63,  63,  63,  63,  63,  63 : REMark 200 .. 209
  754. 6130 DATA  63,  63,  63,  63,  63,  63,  63,  63,  63,  63 : REMark 210 .. 219
  755. 6140 DATA  63,  63,  63,  63,  63,  63,  63,  63,  63,  63 : REMark 220 .. 229
  756. 6150 DATA  63,  63,  63,  63,  63,  63,  63,  63,  63,  63 : REMark 230 .. 239
  757. 6160 DATA  63,  63,  63,  63,  63,  63,  63,  63,  63,  63 : REMark 240 .. 249
  758. 6170 DATA  63,  63,  63,  63,  63,  63                     : REMark 250 .. 255
  759. 6180 REMark MISSING: oe/OE ellipsis (139, 171), Alpha, Theta, Lambda, Pi, Phi (172,
  760. 6190 REMark 174, 175, 177, 178), Backward S (181), arrowheads (188, 189, 190, 191).
  761. 6200 REMark This SuperBASIC show Qdos codes: FOR I=127 TO 191 : PRINT I!!CHR$(I)!!!
  762. 6210 REMark This table translates QL & Thor Quill accents and other non 7 bit ASCII
  763. 6220 REMark codes into the ANSI character codes used by Amiga AND Windoze programs.
  764.